home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / database / tpndx_sk / ndx_seek.pas next >
Pascal/Delphi Source File  |  1991-03-23  |  2KB  |  104 lines
  1. {$E+,I-,N+,R-,V- -80x87 emulation, no I/O errors, no range checks}
  2.  
  3. PROGRAM NDX_Seek;
  4.  
  5. USES NDX, dBASE;
  6.  
  7. VAR
  8.   N, N1: _NDX;
  9.   D: DBFile;
  10.   DBFrecP: CharPtr;
  11.   Key: KeyStr;
  12.   NKey: Double;
  13.   Count, ec: INTEGER;
  14.  
  15. CONST
  16.   Done: Boolean = FALSE;
  17.   Quick: Boolean = FALSE;
  18.  
  19. Procedure DisplayRec (RecNo: LONGINT);
  20.  BEGIN
  21.   IF RecNo <> 0 THEN
  22.    BEGIN
  23.     DBFreadRec (RecNo, D, DBFrecP);
  24.     DBFdispRec (RecNo, D, DBFrecP);
  25.     Inc (Count);
  26.    END;
  27.  END;
  28.  
  29.  {$F+} PROCEDURE ProcessRec (Var N: _NDX; Var entry: NDXentry);
  30.   BEGIN
  31.    DisplayRec (Entry^.RecNo);
  32.   END;
  33.  {$F-}
  34.  
  35. BEGIN
  36. NDXopen (N, 'Test.NDX');
  37. NDXopen (N1, 'NTEST.NDX');
  38. D := DBFopen ('Test.DBF');
  39. IF DBFreadHdr (D) <> 0 THEN
  40.   BEGIN
  41.    WriteLn(' Error reading DBF or DBF empty.');
  42.    Halt(1);
  43.   END;
  44.  If Not DBFreadStru (D) THEN
  45.   BEGIN
  46.     WriteLn ('Error Reading DBF Field Information.');
  47.     Halt (1);
  48.   END;
  49.  
  50. GetMem (DBFrecP, D^.RecLen);
  51.  
  52. WHILE NOT Done DO
  53.  BEGIN
  54.    Count :=0;
  55.    Write ('Enter key ("/h" for help): ');
  56.    ReadLn(Key);
  57.    IF Key = '/l' THEN
  58.      NDXTraverse (N, ProcessRec)
  59.    ELSE IF Key = '/ln' THEN
  60.      NDXTraverse (n1, ProcessRec)
  61.    ELSE IF Key = '/x' THEN
  62.      Done := TRUE
  63.    ELSE IF Key = '/exact on' THEN
  64.      SetExact := TRUE
  65.    ELSE IF Key = '/exact off' THEN
  66.      SetExact := FALSE
  67.    ELSE IF Key ='/quick on' THEN
  68.      Quick := TRUE
  69.    ELSE IF Key ='quick off' THEN
  70.      Quick := FALSE
  71.    ELSE IF Key = '/h' THEN
  72.     BEGIN
  73.      WriteLn ('Enter alphanumeric or numeric key or:');
  74.      WriteLn (' /l          -list all alphanumerically');
  75.      WriteLn (' /ln         -list all numericallly');
  76.      WriteLn (' /x          -Exit');
  77.      WriteLn (' /exact on   -match key exactly');
  78.      WriteLn (' /exact off  -match key to letters typed');
  79.      WriteLn (' /quick on   -match first record only');
  80.      WriteLn (' /quick off  -match first record only');
  81.     END
  82.    ELSE
  83.     BEGIN
  84.      Val (Key, NKey, ec);
  85.      IF ec = 0 THEN
  86.       IF Quick THEN
  87.        DisplayRec (NDXseekN (N1, NKey))
  88.       ELSE
  89.        NDXseekAllN (N1, ProcessRec, NKEy)
  90.      ELSE
  91.        IF Quick THEN
  92.          DisplayRec (NDXseek (N, Key));
  93.        ELSE
  94.          NDXseekAll (N, ProcessRec, Key);
  95.    END;
  96.  
  97.   WriteLn ('=>Count=', Count,'; Quick=', quick,'Exact=',SetExact);
  98.   END;
  99.  
  100. NDXclose (N);
  101. NDXclose (N1);
  102. IF DBFclose (D) THEN
  103. END.
  104.